home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tab / tab.bas < prev    next >
Encoding:
BASIC Source File  |  1993-11-24  |  4.8 KB  |  111 lines
  1. Option Explicit
  2.  
  3. Sub TabDialog (tc As Form, Items() As String, ActiveTab As Integer, ByVal XPos As Long, ByVal YPos As Long)
  4.  
  5. '***    Produces Tabbed dialog boxes aka Paradox and Word 6
  6.  
  7. '***    Forces form to be scaled on Pixels
  8.  
  9. '***    tc          Form on which to operate
  10. '***    Items()     Array containing items for tabs dimmed to correct no entities
  11. '***    ActiveTab   Current Active Tab passed to/from routine
  12. '***    Xpos,YPos   of mouse pointer (0 in no click, just draw)
  13.  
  14.  
  15.     Dim NoItems As Integer, ItemWidth  As Integer
  16.     Dim c As Integer, x As Long
  17.     Dim x1 As Long
  18.  
  19.     Const LabHeight = 18            '*** Height of labels
  20.     Const Offset = 4                '*** Offset from top of screen
  21.     Const HighLightCol = &HFFFFFF   '*** Colour used for highlighting
  22.     Const LowLightCol = &H808080    '*** Colour used for lowlighting
  23.  
  24.     tc.ScaleMode = 3'*** Form must be Pixels!
  25.  
  26.  
  27.     If ActiveTab = 0 Then '*** Clicked somewhere
  28.         If YPos < Offset Or YPos > Offset + LabHeight Then '*** not in tab !
  29.             Exit Sub                                       '*** get out
  30.         End If
  31.     End If
  32.  
  33.     NoItems = UBound(Items)
  34.     ItemWidth = (tc.ScaleWidth - 2) / NoItems
  35.  
  36.     '*** Clear existing tabs drawn
  37.     tc.Line (0, 0)-(Screen.Width - 2, LabHeight + Offset + 1), tc.BackColor, BF
  38.  
  39.     '*** Draw up initial black lines/boxing
  40.     x = 0
  41.     For c = 1 To NoItems
  42.         tc.Line (x, LabHeight + Offset)-(x, 4 + Offset), 0
  43.         tc.Line (x, 4 + Offset)-(x + 4, 0 + Offset), 0
  44.         tc.Line (x + 4, 0 + Offset)-(x + ItemWidth - 4, 0 + Offset), 0
  45.         tc.Line (x + ItemWidth - 4, 0 + Offset)-(x + ItemWidth, 4 + Offset), 0
  46.         tc.Line (x + ItemWidth, 4 + Offset)-(x + ItemWidth, LabHeight + Offset + 2), 0
  47.         x = x + ItemWidth
  48.     Next c
  49.     tc.Line (0, LabHeight + Offset)-(0, tc.ScaleHeight - 1), 0
  50.     tc.Line (0, tc.ScaleHeight - 1)-((ItemWidth * NoItems), tc.ScaleHeight - 1), 0
  51.     tc.Line ((ItemWidth * NoItems), tc.ScaleHeight - 1)-((ItemWidth * NoItems), LabHeight + Offset), 0
  52.     
  53.     '*** Draw 3D bit around main form
  54.     tc.Line (1, LabHeight + Offset)-(1, tc.ScaleHeight - 1), HighLightCol
  55.     tc.Line (2, LabHeight + Offset)-(2, tc.ScaleHeight - 1), HighLightCol
  56.     tc.Line (2, tc.ScaleHeight - 2)-((ItemWidth * NoItems) - 1, tc.ScaleHeight - 2), LowLightCol
  57.     tc.Line (3, tc.ScaleHeight - 3)-((ItemWidth * NoItems) - 2, tc.ScaleHeight - 3), LowLightCol
  58.     tc.Line ((ItemWidth * NoItems) - 1, tc.ScaleHeight - 2)-((ItemWidth * NoItems) - 1, LabHeight + Offset), LowLightCol
  59.     tc.Line ((ItemWidth * NoItems) - 2, tc.ScaleHeight - 2)-((ItemWidth * NoItems) - 2, LabHeight + Offset), LowLightCol
  60.     
  61.     If XPos <> 0 Then               '***  Clicked on tab somewhere, work-out where
  62.         ActiveTab = Int(XPos / ItemWidth) + 1
  63.     End If
  64.  
  65.     If ActiveTab = 0 Then           '*** Just in case make sure one is active
  66.         ActiveTab = 1
  67.     End If
  68.  
  69.     '*** Draw 3D bit around Active Tab
  70.     x = (ActiveTab - 1) * ItemWidth
  71.     tc.Line (x + 1, LabHeight + Offset)-(x + 1, 4 + Offset), HighLightCol
  72.     tc.Line (x + 1, 4 + Offset)-(x + 4, 1 + 0 + Offset), HighLightCol
  73.     tc.Line (x + 2, LabHeight + Offset)-(x + 2, 4 + Offset), HighLightCol
  74.     tc.Line (x + 2, 4 + Offset)-(x + 5, 1 + 0 + Offset), HighLightCol
  75.     tc.Line (x + 4, 1 + 0 + Offset)-(x + ItemWidth - 4, 1 + 0 + Offset), HighLightCol
  76.     tc.Line (x + ItemWidth - 4, 1 + 0 + Offset)-(x + ItemWidth - 1, 4 + Offset), LowLightCol
  77.     tc.Line (x + ItemWidth - 1, 4 + Offset)-(x + ItemWidth - 1, LabHeight + Offset + 2), LowLightCol
  78.     tc.Line (x + ItemWidth - 5, 1 + 0 + Offset)-(x + ItemWidth - 2, 4 + Offset), LowLightCol
  79.     tc.Line (x + ItemWidth - 2, 4 + Offset)-(x + ItemWidth - 2, LabHeight + Offset + 2), LowLightCol
  80.  
  81.     '*** Draw 3D Horz line to the left of active tab
  82.     x = 2
  83.     x1 = ((ActiveTab - 1) * ItemWidth) + 1
  84.     If x <> x1 + 1 Then
  85.         tc.Line (x - 1, LabHeight + Offset)-(x1, LabHeight + Offset), 0
  86.         tc.Line (x, LabHeight + Offset + 1)-(x1 + 1, LabHeight + Offset + 1), HighLightCol
  87.     End If
  88.     '*** Draw 3D Horz line to the right of active tab
  89.     x = ActiveTab * ItemWidth
  90.     x1 = (ItemWidth * NoItems) - 2
  91.     If x <> x1 + 2 Then
  92.         tc.Line (x, LabHeight + Offset)-(x1 + 1, LabHeight + Offset), 0
  93.         tc.Line (x - 1, LabHeight + Offset + 1)-(x1, LabHeight + Offset + 1), HighLightCol
  94.     End If
  95.     
  96.     '*** Put Text on tabs
  97.     x = 0
  98.     tc.CurrentY = Offset + ((LabHeight / 2) - (tc.TextHeight("X") / 2))
  99.     For c = 1 To NoItems
  100.         If c = ActiveTab Then
  101.             tc.FontBold = True
  102.         Else
  103.             tc.FontBold = False
  104.         End If
  105.         tc.CurrentX = x + (ItemWidth / 2) - (tc.TextWidth(Trim(Items(c))) / 2)
  106.         tc.Print Trim(Items(c));
  107.         x = x + ItemWidth
  108.     Next c
  109. End Sub
  110.  
  111.